home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / POPP.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-11  |  33.9 KB  |  1,011 lines  |  [.Ob./.Ob4]
  1. Syntax10b.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE POPP;    (* NW, RC 6.3.89 / 10.2.94 *)
  5.     IMPORT
  6.         OPT := POPT, OPS := POPS, OPM := POPM, OPB := POPB;
  7.     CONST
  8.         (* numtyp values *)
  9.         char = 1; integer = 2; real = 3; longreal = 4;
  10.         (* symbol values *)
  11.         null = 0; times = 1; slash = 2; div = 3; mod = 4;
  12.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  13.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  14.         in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  15.         colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  16.         of = 25; then = 26; do = 27; to = 28; by = 29;
  17.         lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  18.         number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  19.         bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  20.         if = 45; case = 46; while = 47; repeat = 48; for = 49;
  21.         loop = 50; with = 51; exit = 52; return = 53; array = 54;
  22.         record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  23.         var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  24.         (* object modes *)
  25.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  26.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  27.         (* Structure forms *)
  28.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  29.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  30.         Pointer = 13; ProcTyp = 14; Comp = 15;
  31.         intSet = {SInt..LInt};
  32.         (* composite structure forms *)
  33.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  34.         (*function number*)
  35.         haltfn = 0; newfn = 1; incfn = 13; sysnewfn = 30;
  36.         (* nodes classes *)
  37.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  38.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  39.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  40.         Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  41.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  42.         (* node subclasses *)
  43.         super = 1;
  44.         (* module visibility of objects *)
  45.         internal = 0; external = 1; externalR = 2;
  46.         (* procedure flags (conval^.setval) *)
  47.         hasBody = 1; isRedef = 2; slNeeded = 3;
  48.     TYPE
  49.         CaseTable = ARRAY OPM.MaxCases OF
  50.             RECORD
  51.                 low, high: LONGINT
  52.             END ;
  53.         sym, level: SHORTINT;
  54.         LoopLevel: INTEGER;
  55.         TDinit, lastTDinit: OPT.Node;
  56.         nofFwdPtr: INTEGER;
  57.         FwdPtr: ARRAY 64 OF OPT.Struct;
  58.     PROCEDURE^ Type(VAR typ, banned: OPT.Struct);
  59.     PROCEDURE^ Expression(VAR x: OPT.Node);
  60.     PROCEDURE^ Block(VAR procdec, statseq: OPT.Node);
  61.     PROCEDURE err(n: INTEGER);
  62.     BEGIN OPM.err(n)
  63.     END err;
  64.     PROCEDURE CheckSym(s: INTEGER);
  65.     BEGIN
  66.         IF sym = s THEN OPS.Get(sym) ELSE OPM.err(s) END
  67.     END CheckSym;
  68.     PROCEDURE qualident(VAR id: OPT.Object);
  69.         VAR obj: OPT.Object; lev: SHORTINT;
  70.     BEGIN (*sym = ident*)
  71.         OPT.Find(obj); OPS.Get(sym);
  72.         IF (sym = period) & (obj # NIL) & (obj^.mode = Mod) THEN
  73.             OPS.Get(sym);
  74.             IF sym = ident THEN
  75.                 OPT.FindImport(obj, obj); OPS.Get(sym)
  76.             ELSE err(ident); obj := NIL
  77.             END
  78.         END ;
  79.         IF obj = NIL THEN err(0);
  80.             obj := OPT.NewObj(); obj^.mode := Var; obj^.typ := OPT.undftyp; obj^.adr := 0
  81.         ELSE lev := obj^.mnolev;
  82.             IF (obj^.mode IN {Var, VarPar}) & (lev # level) THEN
  83.                 obj^.leaf := FALSE;
  84.                 IF lev > 0 THEN OPB.StaticLink(level-lev) END
  85.             END
  86.         END ;
  87.         id := obj
  88.     END qualident;
  89.     PROCEDURE ConstExpression(VAR x: OPT.Node);
  90.     BEGIN Expression(x);
  91.         IF x^.class # Nconst THEN
  92.             err(50); x := OPB.NewIntConst(1) 
  93.         END
  94.     END ConstExpression;
  95.     PROCEDURE CheckMark(VAR vis: SHORTINT);
  96.     BEGIN OPS.Get(sym);
  97.         IF (sym = times) OR (sym = minus) THEN
  98.             IF level > 0 THEN err(47) END ;
  99.             IF sym = times THEN vis := external ELSE vis := externalR END ;
  100.             OPS.Get(sym)
  101.         ELSE vis := internal
  102.         END
  103.     END CheckMark;
  104.     PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
  105.         VAR x: OPT.Node; sf: LONGINT;
  106.     BEGIN
  107.         IF sym = lbrak THEN OPS.Get(sym); ConstExpression(x);
  108.             IF x^.typ^.form IN intSet THEN sf := x^.conval^.intval;
  109.                 IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
  110.             ELSE err(51); sf := 0
  111.             END ;
  112.             sysflag := SHORT(sf); CheckSym(rbrak)
  113.         ELSE sysflag := default
  114.         END
  115.     END CheckSysFlag;
  116.     PROCEDURE RecordType(VAR typ, banned: OPT.Struct);
  117.         VAR fld, first, last, base: OPT.Object;
  118.             ftyp: OPT.Struct; sysflag: INTEGER;
  119.     BEGIN typ := OPT.NewStr(Comp, Record); typ^.BaseTyp := NIL;
  120.         CheckSysFlag(sysflag, -1);
  121.         IF sym = lparen THEN
  122.             OPS.Get(sym); (*record extension*)
  123.             IF sym = ident THEN
  124.                 qualident(base);
  125.                 IF (base^.mode = Typ) & (base^.typ^.comp = Record) THEN
  126.                     IF base^.typ = banned THEN err(58)
  127.                     ELSE typ^.BaseTyp := base^.typ; typ^.extlev := base^.typ^.extlev + 1; typ^.sysflag := base^.typ^.sysflag
  128.                     END
  129.                 ELSE err(52)
  130.                 END
  131.             ELSE err(ident)
  132.             END ;
  133.             CheckSym(rparen)
  134.         END ;
  135.         IF sysflag >= 0 THEN typ^.sysflag := sysflag END ;
  136.         OPT.OpenScope(0, NIL); first := NIL; last := NIL;
  137.         LOOP
  138.             IF sym = ident THEN
  139.                 LOOP
  140.                     IF sym = ident THEN
  141.                         IF typ^.BaseTyp # NIL THEN
  142.                             OPT.FindField(OPS.name, typ^.BaseTyp, fld);
  143.                             IF fld # NIL THEN err(1) END
  144.                         END ;
  145.                         OPT.Insert(OPS.name, fld); CheckMark(fld^.vis);
  146.                         fld^.mode := Fld; fld^.link := NIL; fld^.typ := OPT.undftyp;
  147.                         IF first = NIL THEN first := fld END ;
  148.                         IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ;
  149.                         last := fld
  150.                     ELSE err(ident)
  151.                     END ;
  152.                     IF sym = comma THEN OPS.Get(sym)
  153.                     ELSIF sym = ident THEN err(comma)
  154.                     ELSE EXIT
  155.                     END
  156.                 END ;
  157.                 CheckSym(colon); Type(ftyp, banned);
  158.                 IF ftyp^.comp = DynArr THEN ftyp := OPT.undftyp; err(88) END ;
  159.                 WHILE first # NIL DO
  160.                     first^.typ := ftyp; first := first^.link
  161.                 END
  162.             END ;
  163.             IF sym = semicolon THEN OPS.Get(sym)
  164.             ELSIF sym = ident THEN err(semicolon)
  165.             ELSE EXIT
  166.             END
  167.         END ;
  168.         OPT.CloseScope
  169.     END RecordType;
  170.     PROCEDURE ArrayType(VAR typ, banned: OPT.Struct);
  171.         VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER;
  172.     BEGIN CheckSysFlag(sysflag, 0);
  173.         IF sym = of THEN    (*dynamic array*)
  174.             typ := OPT.NewStr(Comp, DynArr); typ^.mno := 0; typ^.sysflag := sysflag;
  175.             OPS.Get(sym); Type(typ^.BaseTyp, banned);
  176.             IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1
  177.             ELSE typ^.n := 0
  178.             END
  179.         ELSE
  180.             typ := OPT.NewStr(Comp, Array); typ^.sysflag := sysflag; ConstExpression(x);
  181.             IF x^.typ^.form IN intSet THEN n := x^.conval^.intval;
  182.                 IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
  183.             ELSE err(51); n := 1
  184.             END ;
  185.             typ^.n := n;
  186.             IF sym = of THEN
  187.                 OPS.Get(sym); Type(typ^.BaseTyp, banned)
  188.             ELSIF sym = comma THEN
  189.                 OPS.Get(sym); IF sym # of THEN ArrayType(typ^.BaseTyp, banned) END
  190.             ELSE err(35)
  191.             END ;
  192.             IF typ^.BaseTyp^.comp = DynArr THEN typ^.BaseTyp := OPT.undftyp; err(88) END
  193.         END
  194.     END ArrayType;
  195.     PROCEDURE PointerType(VAR typ: OPT.Struct);
  196.         VAR id: OPT.Object;
  197.     BEGIN typ := OPT.NewStr(Pointer, Basic); CheckSysFlag(typ^.sysflag, 0);
  198.         CheckSym(to);
  199.         IF sym = ident THEN OPT.Find(id);
  200.             IF id = NIL THEN
  201.                 IF nofFwdPtr < LEN(FwdPtr) THEN FwdPtr[nofFwdPtr] := typ; INC(nofFwdPtr)
  202.                 ELSE err(224)
  203.                 END ;
  204.                 typ^.link := OPT.NewObj(); COPY(OPS.name, typ^.link^.name);
  205.                 typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*)
  206.             ELSE qualident(id);
  207.                 IF id^.mode = Typ THEN
  208.                     IF id^.typ^.comp IN {Array, DynArr, Record} THEN
  209.                         typ^.BaseTyp := id^.typ
  210.                     ELSE typ^.BaseTyp := OPT.undftyp; err(57)
  211.                     END
  212.                 ELSE typ^.BaseTyp := OPT.undftyp; err(52)
  213.                 END
  214.             END
  215.         ELSE Type(typ^.BaseTyp, OPT.notyp);
  216.             IF ~(typ^.BaseTyp^.comp IN {Array, DynArr, Record}) THEN
  217.                 typ^.BaseTyp := OPT.undftyp; err(57)
  218.             END
  219.         END
  220.     END PointerType;
  221.     PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct);
  222.         VAR mode: SHORTINT;
  223.                 par, first, last, res: OPT.Object; typ: OPT.Struct;
  224.     BEGIN first := NIL; last := firstPar;
  225.         IF (sym = ident) OR (sym = var) THEN
  226.             LOOP
  227.                 IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  228.                 LOOP
  229.                     IF sym = ident THEN
  230.                         OPT.Insert(OPS.name, par); OPS.Get(sym);
  231.                         par^.mode := mode; par^.link := NIL;
  232.                         IF first = NIL THEN first := par END ;
  233.                         IF firstPar = NIL THEN firstPar := par ELSE last^.link := par END ;
  234.                         last := par
  235.                     ELSE err(ident)
  236.                     END ;
  237.                     IF sym = comma THEN OPS.Get(sym)
  238.                     ELSIF sym = ident THEN err(comma)
  239.                     ELSIF sym = var THEN err(comma); OPS.Get(sym)
  240.                     ELSE EXIT
  241.                     END
  242.                 END ;
  243.                 CheckSym(colon); Type(typ, OPT.notyp);
  244.                 WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  245.                 IF sym = semicolon THEN OPS.Get(sym)
  246.                 ELSIF sym = ident THEN err(semicolon)
  247.                 ELSE EXIT
  248.                 END
  249.             END
  250.         END ;
  251.         CheckSym(rparen);
  252.         IF sym = colon THEN
  253.             OPS.Get(sym); resTyp := OPT.undftyp;
  254.             IF sym = ident THEN qualident(res);
  255.                 IF res^.mode = Typ THEN
  256.                     IF res^.typ^.form < Comp THEN resTyp := res^.typ
  257.                     ELSE err(54)
  258.                     END
  259.                 ELSE err(52)
  260.                 END
  261.             ELSE err(ident)
  262.             END
  263.         ELSE resTyp := OPT.notyp
  264.         END
  265.     END FormalParameters;
  266.     PROCEDURE TypeDecl(VAR typ, banned: OPT.Struct);
  267.         VAR id: OPT.Object;
  268.     BEGIN typ := OPT.undftyp;
  269.         IF sym < lparen THEN err(12);
  270.             REPEAT OPS.Get(sym) UNTIL sym >= lparen
  271.         END ;
  272.         IF sym = ident THEN qualident(id);
  273.             IF id^.mode = Typ THEN
  274.                 IF id^.typ # banned THEN typ := id^.typ ELSE err(58) END
  275.             ELSE err(52)
  276.             END
  277.         ELSIF sym = array THEN
  278.             OPS.Get(sym); ArrayType(typ, banned)
  279.         ELSIF sym = record THEN
  280.             OPS.Get(sym); RecordType(typ, banned);
  281.             OPB.Inittd(TDinit, lastTDinit, typ); CheckSym(end)
  282.         ELSIF sym = pointer THEN
  283.             OPS.Get(sym); PointerType(typ)
  284.         ELSIF sym = procedure THEN
  285.             OPS.Get(sym); typ := OPT.NewStr(ProcTyp, Basic); CheckSysFlag(typ^.sysflag, 0);
  286.             IF sym = lparen THEN
  287.                 OPS.Get(sym); OPT.OpenScope(level, NIL);
  288.                 FormalParameters(typ^.link, typ^.BaseTyp); OPT.CloseScope
  289.             ELSE typ^.BaseTyp := OPT.notyp; typ^.link := NIL
  290.             END
  291.         ELSE err(12)
  292.         END ;
  293.         LOOP
  294.             IF (sym >= semicolon) & (sym <= else) OR (sym = rparen) OR (sym = eof) THEN EXIT END;
  295.             err(15); IF sym = ident THEN EXIT END;
  296.             OPS.Get(sym)
  297.         END
  298.     END TypeDecl;
  299.     PROCEDURE Type(VAR typ, banned: OPT.Struct);
  300.     BEGIN TypeDecl(typ, banned);
  301.         IF (typ^.form = Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END
  302.     END Type;
  303.     PROCEDURE selector(VAR x: OPT.Node);
  304.         VAR obj, proc: OPT.Object; y: OPT.Node; typ: OPT.Struct; name: OPS.Name;
  305.     BEGIN
  306.         LOOP
  307.             IF sym = lbrak THEN OPS.Get(sym);
  308.                 LOOP
  309.                     IF (x^.typ # NIL) & (x^.typ^.form = Pointer) THEN OPB.DeRef(x) END ;
  310.                     Expression(y); OPB.Index(x, y);
  311.                     IF sym = comma THEN OPS.Get(sym) ELSE EXIT END
  312.                 END ;
  313.                 CheckSym(rbrak)
  314.             ELSIF sym = period THEN OPS.Get(sym);
  315.                 IF sym = ident THEN name := OPS.name; OPS.Get(sym);
  316.                     IF x^.typ # NIL THEN
  317.                         IF x^.typ^.form = Pointer THEN OPB.DeRef(x) END ;
  318.                         IF x^.typ^.comp = Record THEN
  319.                             OPT.FindField(name, x^.typ, obj); OPB.Field(x, obj);
  320.                             IF (obj # NIL) & (obj^.mode = TProc) THEN
  321.                                 IF sym = arrow THEN  (* super call *) OPS.Get(sym);
  322.                                     y := x^.left;
  323.                                     IF y^.class = Nderef THEN y := y^.left END ;    (* y = record variable *)
  324.                                     IF y^.obj # NIL THEN
  325.                                         proc := OPT.topScope;    (* find innermost scope which owner is a TProc *)
  326.                                         WHILE (proc^.link # NIL) & (proc^.link^.mode # TProc) DO proc := proc^.left END ;
  327.                                         IF (proc^.link = NIL) OR (proc^.link^.link # y^.obj) THEN err(75) END ;
  328.                                         typ := y^.obj^.typ;
  329.                                         IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  330.                                         OPT.FindField(x^.obj^.name, typ^.BaseTyp, proc);
  331.                                         IF proc # NIL THEN x^.subcl := super ELSE err(74) END
  332.                                     ELSE err(75)
  333.                                     END
  334.                                 END ;
  335.                                 IF (obj^.typ # OPT.notyp) & (sym # lparen) THEN err(lparen) END
  336.                             END
  337.                         ELSE err(53)
  338.                         END
  339.                     ELSE err(52)
  340.                     END
  341.                 ELSE err(ident)
  342.                 END
  343.             ELSIF sym = arrow THEN OPS.Get(sym); OPB.DeRef(x)
  344.             ELSIF (sym = lparen) & (x^.class < Nconst) & (x^.typ^.form # ProcTyp) &
  345.                     ((x^.obj = NIL) OR (x^.obj^.mode # TProc)) THEN
  346.                 OPS.Get(sym);
  347.                 IF sym = ident THEN
  348.                     qualident(obj);
  349.                     IF obj^.mode = Typ THEN OPB.TypTest(x, obj, TRUE)
  350.                     ELSE err(52)
  351.                     END
  352.                 ELSE err(ident)
  353.                 END ;
  354.                 CheckSym(rparen)
  355.             ELSE EXIT
  356.             END
  357.         END
  358.     END selector;
  359.     PROCEDURE ActualParameters(VAR aparlist: OPT.Node; fpar: OPT.Object);
  360.         VAR apar, last: OPT.Node;
  361.     BEGIN aparlist := NIL; last := NIL;
  362.         IF sym # rparen THEN
  363.             LOOP Expression(apar);
  364.                 IF fpar # NIL THEN
  365.                     OPB.Param(apar, fpar); OPB.Link(aparlist, last, apar);
  366.                     fpar := fpar^.link;
  367.                 ELSE err(64)
  368.                 END ;
  369.                 IF sym = comma THEN OPS.Get(sym)
  370.                 ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  371.                 ELSE EXIT
  372.                 END
  373.             END
  374.         END ;
  375.         IF fpar # NIL THEN err(65) END
  376.     END ActualParameters;
  377.     PROCEDURE StandProcCall(VAR x: OPT.Node);
  378.         VAR y: OPT.Node; m: SHORTINT; n: INTEGER;
  379.     BEGIN m := SHORT(SHORT(x^.obj^.adr)); n := 0;
  380.         IF sym = lparen THEN OPS.Get(sym);
  381.             IF sym # rparen THEN
  382.                 LOOP
  383.                     IF n = 0 THEN Expression(x); OPB.StPar0(x, m); n := 1
  384.                     ELSIF n = 1 THEN Expression(y); OPB.StPar1(x, y, m); n := 2
  385.                     ELSE Expression(y); OPB.StParN(x, y, m, n); INC(n)
  386.                     END ;
  387.                     IF sym = comma THEN OPS.Get(sym)
  388.                     ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  389.                     ELSE EXIT
  390.                     END
  391.                 END ;
  392.                 CheckSym(rparen)
  393.             ELSE OPS.Get(sym)
  394.             END ;
  395.             OPB.StFct(x, m, n)
  396.         ELSE err(lparen)
  397.         END ;
  398.         IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END
  399.     END StandProcCall;
  400.     PROCEDURE Element(VAR x: OPT.Node);
  401.         VAR y: OPT.Node;
  402.     BEGIN Expression(x);
  403.         IF sym = upto THEN
  404.             OPS.Get(sym); Expression(y); OPB.SetRange(x, y)
  405.         ELSE OPB.SetElem(x)
  406.         END
  407.     END Element;
  408.     PROCEDURE Sets(VAR x: OPT.Node);
  409.         VAR y: OPT.Node;
  410.     BEGIN
  411.         IF sym # rbrace THEN
  412.             Element(x);
  413.             LOOP
  414.                 IF sym = comma THEN OPS.Get(sym)
  415.                 ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  416.                 ELSE EXIT
  417.                 END ;
  418.                 Element(y); OPB.Op(plus, x, y)
  419.             END
  420.         ELSE x := OPB.EmptySet()
  421.         END ;
  422.         CheckSym(rbrace)
  423.     END Sets;
  424.     PROCEDURE Factor(VAR x: OPT.Node);
  425.         VAR fpar, id: OPT.Object; apar: OPT.Node;
  426.     BEGIN
  427.         IF sym < lparen THEN err(13);
  428.             REPEAT OPS.Get(sym) UNTIL sym >= lparen
  429.         END ;
  430.         IF sym = ident THEN
  431.             qualident(id); x := OPB.NewLeaf(id); selector(x);
  432.             IF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN StandProcCall(x)    (* x may be NIL *)
  433.             ELSIF sym = lparen THEN
  434.                 OPS.Get(sym); OPB.PrepCall(x, fpar);
  435.                 ActualParameters(apar, fpar);
  436.                 OPB.Call(x, apar, fpar);
  437.                 CheckSym(rparen);
  438.                 IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  439.             END
  440.         ELSIF sym = number THEN
  441.             CASE OPS.numtyp OF
  442.                char: x := OPB.NewIntConst(OPS.intval); x^.typ := OPT.chartyp
  443.             | integer: x := OPB.NewIntConst(OPS.intval)
  444.             | real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp)
  445.             | longreal: x := OPB.NewRealConst(OPS.lrlval, OPT.lrltyp)
  446.             END ;
  447.             OPS.Get(sym)
  448.         ELSIF sym = string THEN
  449.             x := OPB.NewString(OPS.str, OPS.intval); OPS.Get(sym)
  450.         ELSIF sym = nil THEN
  451.             x := OPB.Nil(); OPS.Get(sym)
  452.         ELSIF sym = lparen THEN
  453.             OPS.Get(sym); Expression(x); CheckSym(rparen)
  454.         ELSIF sym = lbrak THEN
  455.             OPS.Get(sym); err(lparen); Expression(x); CheckSym(rparen)
  456.         ELSIF sym = lbrace THEN OPS.Get(sym); Sets(x)
  457.         ELSIF sym = not THEN
  458.             OPS.Get(sym); Factor(x); OPB.MOp(not, x)
  459.         ELSE err(13); OPS.Get(sym); x := NIL
  460.         END ;
  461.         IF x = NIL THEN x := OPB.NewIntConst(1); x^.typ := OPT.undftyp END
  462.     END Factor;
  463.     PROCEDURE Term(VAR x: OPT.Node);
  464.         VAR y: OPT.Node; mulop: SHORTINT;
  465.     BEGIN Factor(x);
  466.         WHILE (times <= sym) & (sym <= and) DO
  467.             mulop := sym; OPS.Get(sym);
  468.             Factor(y); OPB.Op(mulop, x, y)
  469.         END
  470.     END Term;
  471.     PROCEDURE SimpleExpression(VAR x: OPT.Node);
  472.         VAR y: OPT.Node; addop: SHORTINT;
  473.     BEGIN
  474.         IF sym = minus THEN OPS.Get(sym); Term(x); OPB.MOp(minus, x)
  475.         ELSIF sym = plus THEN OPS.Get(sym); Term(x); OPB.MOp(plus, x)
  476.         ELSE Term(x)
  477.         END ;
  478.         WHILE (plus <= sym) & (sym <= or) DO
  479.             addop := sym; OPS.Get(sym);
  480.             Term(y); OPB.Op(addop, x, y)
  481.         END
  482.     END SimpleExpression;
  483.     PROCEDURE Expression(VAR x: OPT.Node);
  484.         VAR y: OPT.Node; obj: OPT.Object; relation: SHORTINT;
  485.     BEGIN SimpleExpression(x);
  486.         IF (eql <= sym) & (sym <= geq) THEN
  487.             relation := sym; OPS.Get(sym);
  488.             SimpleExpression(y); OPB.Op(relation, x, y)
  489.         ELSIF sym = in THEN
  490.             OPS.Get(sym); SimpleExpression(y); OPB.In(x, y)
  491.         ELSIF sym = is THEN
  492.             OPS.Get(sym);
  493.             IF sym = ident THEN
  494.                 qualident(obj);
  495.                 IF obj^.mode = Typ THEN OPB.TypTest(x, obj, FALSE)
  496.                 ELSE err(52)
  497.                 END
  498.             ELSE err(ident)
  499.             END
  500.         END
  501.     END Expression;
  502.     PROCEDURE Receiver(VAR mode: SHORTINT; VAR name: OPS.Name; VAR typ, rec: OPT.Struct);
  503.         VAR obj: OPT.Object;
  504.     BEGIN typ := OPT.undftyp; rec := NIL;
  505.         IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  506.         name := OPS.name; CheckSym(ident); CheckSym(colon);
  507.         IF sym = ident THEN OPT.Find(obj); OPS.Get(sym);
  508.             IF obj = NIL THEN err(0)
  509.             ELSIF obj^.mode # Typ THEN err(72)
  510.             ELSE typ := obj^.typ; rec := typ;
  511.                 IF rec^.form = Pointer THEN rec := rec^.BaseTyp END ;
  512.                 IF ~((mode = Var) & (typ^.form = Pointer) & (rec^.comp = Record) OR
  513.                     (mode = VarPar) & (typ^.comp = Record)) THEN err(70); rec := NIL END ;
  514.                 IF (rec # NIL) & (rec^.mno # level) THEN err(72); rec := NIL END
  515.             END
  516.         ELSE err(ident)
  517.         END ;
  518.         CheckSym(rparen);
  519.         IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END
  520.     END Receiver;
  521.     PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN;
  522.     BEGIN
  523.         IF (b^.form = Pointer) & (x^.form = Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ;
  524.         IF (b^.comp = Record) & (x^.comp = Record) THEN
  525.             REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b)
  526.         END ;
  527.         RETURN x = b
  528.     END Extends;
  529.     PROCEDURE ProcedureDeclaration(VAR x: OPT.Node);
  530.         VAR proc, fwd: OPT.Object;
  531.             name: OPS.Name;
  532.             mode, vis: SHORTINT;
  533.             forward: BOOLEAN;
  534.         PROCEDURE GetCode;
  535.             VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT;
  536.         BEGIN
  537.             ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
  538.             IF sym = string THEN
  539.                 WHILE OPS.str[n] # 0X DO ext[n+1] := OPS.str[n]; INC(n) END ;
  540.                 ext^[0] := CHR(n); OPS.Get(sym)
  541.             ELSE
  542.                 LOOP
  543.                     IF sym = number THEN c := OPS.intval; INC(n);
  544.                         IF (c < 0) OR (c > 255) OR (n = OPT.MaxConstLen) THEN
  545.                             err(64); c := 1; n := 1
  546.                         END ;
  547.                         OPS.Get(sym); ext^[n] := CHR(c)
  548.                     END ;
  549.                     IF sym = comma THEN OPS.Get(sym)
  550.                     ELSIF sym = number THEN err(comma)
  551.                     ELSE ext^[0] := CHR(n); EXIT
  552.                     END
  553.                 END
  554.             END ;
  555.             INCL(proc^.conval^.setval, hasBody)
  556.         END GetCode;
  557.         PROCEDURE GetParams;
  558.         BEGIN
  559.             proc^.vis := vis; proc^.mode := mode; proc^.typ := OPT.notyp;
  560.             proc^.conval := OPT.NewConst(); proc^.conval^.setval := {};
  561.             IF sym = lparen THEN
  562.                 OPS.Get(sym); FormalParameters(proc^.link, proc^.typ)
  563.             END ;
  564.             IF fwd # NIL THEN
  565.                 OPB.CheckParameters(proc^.link, fwd^.link, TRUE);
  566.                 IF proc^.typ # fwd^.typ THEN err(117) END ;
  567.                 proc := fwd; OPT.topScope := proc^.scope;
  568.                 IF mode = IProc THEN proc^.mode := IProc END
  569.             END
  570.         END GetParams;
  571.         PROCEDURE Body;
  572.             VAR procdec, statseq: OPT.Node; c: LONGINT;
  573.         BEGIN
  574.             c := OPM.errpos;
  575.             INCL(proc^.conval^.setval, hasBody);
  576.             CheckSym(semicolon); Block(procdec, statseq);
  577.             OPB.Enter(procdec, statseq, proc); x := procdec;
  578.             x^.conval := OPT.NewConst(); x^.conval^.intval := c;
  579.             IF sym = ident THEN
  580.                 IF OPS.name # proc^.name THEN err(4) END ;
  581.                 OPS.Get(sym)
  582.             ELSE err(ident)
  583.             END
  584.         END Body;
  585.         PROCEDURE TProcDecl;
  586.             VAR baseProc: OPT.Object;
  587.                 objTyp, recTyp: OPT.Struct;
  588.                 objMode: SHORTINT;
  589.                 objName: OPS.Name;
  590.         BEGIN
  591.             OPS.Get(sym); mode := TProc;
  592.             IF level > 0 THEN err(73) END ;
  593.             Receiver(objMode, objName, objTyp, recTyp);
  594.             IF sym = ident THEN
  595.                 name := OPS.name; CheckMark(vis);
  596.                 OPT.FindField(name, recTyp, fwd);
  597.                 OPT.FindField(name, recTyp^.BaseTyp, baseProc);
  598.                 IF (baseProc # NIL) & (baseProc^.mode # TProc) THEN baseProc := NIL END ;
  599.                 IF fwd = baseProc THEN fwd := NIL END ;
  600.                 IF (fwd # NIL) & (fwd^.mnolev # level) THEN fwd := NIL END ;
  601.                 IF (fwd # NIL) & (fwd^.mode = TProc) & ~(hasBody IN fwd^.conval^.setval) THEN
  602.                     (* there exists a corresponding forward declaration *)
  603.                     proc := OPT.NewObj(); proc^.leaf := TRUE;
  604.                     IF fwd^.vis # vis THEN err(118) END
  605.                 ELSE
  606.                     IF fwd # NIL THEN err(1); fwd := NIL END ;
  607.                     OPT.OpenScope(0, NIL); OPT.topScope^.right := recTyp^.link; OPT.Insert(name, proc);
  608.                     recTyp^.link := OPT.topScope^.right; OPT.CloseScope; 
  609.                 END ;
  610.                 INC(level); OPT.OpenScope(level, proc);
  611.                 OPT.Insert(objName, proc^.link); proc^.link^.mode := objMode; proc^.link^.typ := objTyp;
  612.                 GetParams;
  613.                 IF baseProc # NIL THEN
  614.                     IF (objMode # baseProc^.link^.mode) OR ~Extends(objTyp, baseProc^.link^.typ) THEN err(115) END ;
  615.                     OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE);
  616.                     IF proc^.typ # baseProc^.typ THEN err(117) END ;
  617.                     IF (baseProc^.vis = external) & (proc^.vis = internal) &
  618.                         (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = external) THEN err(109)
  619.                     END ;
  620.                     INCL(proc^.conval^.setval, isRedef)
  621.                 END ;
  622.                 IF ~forward THEN Body END ;
  623.                 DEC(level); OPT.CloseScope
  624.             ELSE err(ident)
  625.             END
  626.         END TProcDecl;
  627.     BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc;
  628.         IF (sym # ident) & (sym # lparen) THEN
  629.             IF sym = times THEN    (* mode set later in OPB.CheckAssign *)
  630.             ELSIF sym = arrow THEN forward := TRUE
  631.             ELSIF sym = plus THEN mode := IProc
  632.             ELSIF sym = minus THEN mode := CProc
  633.             ELSE err(ident)
  634.             END ;
  635.             IF (mode IN {IProc, CProc}) & ~OPT.SYSimported THEN err(135) END ;
  636.             OPS.Get(sym)
  637.         END ;
  638.         IF sym = lparen THEN TProcDecl
  639.         ELSIF sym = ident THEN OPT.Find(fwd);
  640.             name := OPS.name; CheckMark(vis);
  641.             IF (vis # internal) & (mode = LProc) THEN mode := XProc END ;
  642.             IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = SProc)) THEN fwd := NIL END ;
  643.             IF (fwd # NIL) & (fwd^.mode IN {LProc, XProc}) & ~(hasBody IN fwd^.conval^.setval) THEN
  644.                 (* there exists a corresponding forward declaration *)
  645.                 proc := OPT.NewObj(); proc^.leaf := TRUE;
  646.                 IF fwd^.vis # vis THEN err(118) END
  647.             ELSE
  648.                 IF fwd # NIL THEN err(1); fwd := NIL END ;
  649.                 OPT.Insert(name, proc)
  650.             END ;
  651.             IF (mode # LProc) & (level > 0) THEN err(73) END ;
  652.             INC(level); OPT.OpenScope(level, proc);
  653.             proc^.link := NIL; GetParams;
  654.             IF mode = CProc THEN GetCode
  655.             ELSIF ~forward THEN Body
  656.             END ;
  657.             DEC(level); OPT.CloseScope
  658.         ELSE err(ident)
  659.         END
  660.     END ProcedureDeclaration;
  661.     PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelForm: INTEGER; VAR n: INTEGER; VAR tab: CaseTable);
  662.         VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
  663.     BEGIN lab := NIL; lastlab := NIL;
  664.         LOOP ConstExpression(x); f := x^.typ^.form;
  665.             IF f IN intSet + {Char} THEN  xval := x^.conval^.intval
  666.             ELSE err(61); xval := 1
  667.             END ;
  668.             IF f IN intSet THEN
  669.                 IF LabelForm < f THEN err(60) END
  670.             ELSIF LabelForm # f THEN err(60)
  671.             END ;
  672.             IF sym = upto THEN
  673.                 OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval;
  674.                 IF (y^.typ^.form # f) & ~((f IN intSet) & (y^.typ^.form IN intSet)) THEN err(60) END ;
  675.                 IF yval < xval THEN err(63); yval := xval END
  676.             ELSE yval := xval
  677.             END ;
  678.             x^.conval^.intval2 := yval;
  679.             (*enter label range into ordered table*)  i := n;
  680.             IF i < OPM.MaxCases THEN
  681.                 LOOP
  682.                     IF i = 0 THEN EXIT END ;
  683.                     IF tab[i-1].low <= yval THEN
  684.                         IF tab[i-1].high >= xval THEN err(62) END ;
  685.                         EXIT
  686.                     END ;
  687.                     tab[i] := tab[i-1]; DEC(i)
  688.                 END ;
  689.                 tab[i].low := xval; tab[i].high := yval; INC(n)
  690.             ELSE err(213)
  691.             END ;
  692.             OPB.Link(lab, lastlab, x);
  693.             IF sym = comma THEN OPS.Get(sym)
  694.             ELSIF (sym = number) OR (sym = ident) THEN err(comma)
  695.             ELSE EXIT
  696.             END
  697.         END
  698.     END CaseLabelList;
  699.     PROCEDURE StatSeq(VAR stat: OPT.Node);
  700.         VAR fpar, id, t, obj: OPT.Object; idtyp: OPT.Struct; e: BOOLEAN;
  701.                 s, x, y, z, apar, last, lastif: OPT.Node; pos: LONGINT; name: OPS.Name;
  702.         PROCEDURE CasePart(VAR x: OPT.Node);
  703.             VAR n: INTEGER; low, high: LONGINT; e: BOOLEAN;
  704.                     tab: CaseTable; cases, lab, y, lastcase: OPT.Node; 
  705.         BEGIN
  706.             Expression(x); pos := OPM.errpos;
  707.             IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
  708.             ELSIF ~(x^.typ^.form IN {Char..LInt}) THEN err(125)
  709.             END ;
  710.             CheckSym(of); cases := NIL; lastcase := NIL; n := 0;
  711.             LOOP
  712.                 IF sym < bar THEN
  713.                     CaseLabelList(lab, x^.typ^.form, n, tab);
  714.                     CheckSym(colon); StatSeq(y);
  715.                     OPB.Construct(Ncasedo, lab, y); OPB.Link(cases, lastcase, lab)
  716.                 END ;
  717.                 IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  718.             END ;
  719.             IF n > 0 THEN low := tab[0].low; high := tab[n-1].high;
  720.                 IF high - low > OPM.MaxCaseRange THEN err(209) END
  721.             ELSE low := 1; high := 0
  722.             END ;
  723.             e := sym = else;
  724.             IF e THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL END ;
  725.             OPB.Construct(Ncaselse, cases, y); OPB.Construct(Ncase, x, cases);
  726.             cases^.conval := OPT.NewConst();
  727.             cases^.conval^.intval := low; cases^.conval^.intval2 := high;
  728.             IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END
  729.         END CasePart;
  730.         PROCEDURE SetPos(x: OPT.Node);
  731.         BEGIN
  732.             x^.conval := OPT.NewConst(); x^.conval^.intval := pos
  733.         END SetPos;
  734.         PROCEDURE CheckBool(VAR x: OPT.Node);
  735.         BEGIN
  736.             IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126); x := OPB.NewBoolConst(FALSE)
  737.             ELSIF x^.typ^.form # Bool THEN err(120); x := OPB.NewBoolConst(FALSE)
  738.             END ;
  739.             pos := OPM.errpos
  740.         END CheckBool;
  741.     BEGIN stat := NIL; last := NIL;
  742.         LOOP x := NIL;
  743.             IF sym < ident THEN err(14);
  744.                 REPEAT OPS.Get(sym) UNTIL sym >= ident
  745.             END ;
  746.             IF sym = ident THEN
  747.                 qualident(id); x := OPB.NewLeaf(id); selector(x);
  748.                 IF sym = becomes THEN
  749.                     OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  750.                 ELSIF sym = eql THEN
  751.                     err(becomes); OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  752.                 ELSIF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN
  753.                     StandProcCall(x);
  754.                     IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END
  755.                 ELSE OPB.PrepCall(x, fpar);
  756.                     IF sym = lparen THEN
  757.                         OPS.Get(sym); ActualParameters(apar, fpar); CheckSym(rparen)
  758.                     ELSE apar := NIL;
  759.                         IF fpar # NIL THEN err(65) END
  760.                     END ;
  761.                     OPB.Call(x, apar, fpar);
  762.                     IF x^.typ # OPT.notyp THEN err(55) END ;
  763.                     IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  764.                 END ;
  765.                 pos := OPM.errpos
  766.             ELSIF sym = if THEN
  767.                 OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(then); StatSeq(y);
  768.                 OPB.Construct(Nif, x, y); SetPos(x); lastif := x;
  769.                 WHILE sym = elsif DO
  770.                     OPS.Get(sym); Expression(y); CheckBool(y); CheckSym(then); StatSeq(z);
  771.                     OPB.Construct(Nif, y, z); SetPos(y); OPB.Link(x, lastif, y);
  772.                 END ;
  773.                 IF sym = else THEN OPS.Get(sym); StatSeq(y)
  774.                 ELSE y := NIL
  775.                 END ;
  776.                 OPB.Construct(Nifelse, x, y); CheckSym(end); OPB.OptIf(x); pos := OPM.errpos
  777.             ELSIF sym = case THEN
  778.                 OPS.Get(sym); CasePart(x); CheckSym(end)
  779.             ELSIF sym = while THEN
  780.                 OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(do); StatSeq(y);
  781.                 OPB.Construct(Nwhile, x, y); CheckSym(end)
  782.             ELSIF sym = repeat THEN
  783.                 OPS.Get(sym); StatSeq(x);
  784.                 IF sym = until THEN OPS.Get(sym); Expression(y); CheckBool(y)
  785.                 ELSE err(until)
  786.                 END ;
  787.                 OPB.Construct(Nrepeat, x, y)
  788.             ELSIF sym = for THEN
  789.                 OPS.Get(sym);
  790.                 IF sym = ident THEN qualident(id);
  791.                     IF ~(id^.typ^.form IN intSet) THEN err(68) END ;
  792.                     CheckSym(becomes); Expression(y); pos := OPM.errpos;
  793.                     x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x);
  794.                     CheckSym(to); Expression(y); pos := OPM.errpos;
  795.                     IF y^.class # Nconst THEN
  796.                         name := "@@"; OPT.Insert(name, t); t^.name := "@for";
  797.                         t^.mode := Var; t^.typ := x^.left^.typ;
  798.                         obj := OPT.topScope^.scope;
  799.                         IF obj = NIL THEN OPT.topScope^.scope := t
  800.                         ELSE
  801.                             WHILE obj^.link # NIL DO obj := obj^.link END ;
  802.                             obj^.link := t
  803.                         END ;
  804.                         z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z);
  805.                         y := OPB.NewLeaf(t)
  806.                     ELSIF (y^.typ^.form < SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113)
  807.                     END ;
  808.                     OPB.Link(stat, last, x);
  809.                     IF sym = by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ;
  810.                     pos := OPM.errpos; x := OPB.NewLeaf(id);
  811.                     IF z^.conval^.intval > 0 THEN OPB.Op(leq, x, y)
  812.                     ELSIF z^.conval^.intval < 0 THEN OPB.Op(geq, x, y)
  813.                     ELSE err(63); OPB.Op(geq, x, y)
  814.                     END ;
  815.                     CheckSym(do); StatSeq(s);
  816.                     y := OPB.NewLeaf(id); OPB.StPar1(y, z, incfn); SetPos(y);
  817.                     IF s = NIL THEN s := y
  818.                     ELSE z := s;
  819.                         WHILE z^.link # NIL DO z := z^.link END ;
  820.                         z^.link := y
  821.                     END ;
  822.                     CheckSym(end); OPB.Construct(Nwhile, x, s)
  823.                 ELSE err(ident)
  824.                 END
  825.             ELSIF sym = loop THEN
  826.                 OPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel);
  827.                 OPB.Construct(Nloop, x, NIL); CheckSym(end); pos := OPM.errpos
  828.             ELSIF sym = with THEN
  829.                 OPS.Get(sym); idtyp := NIL; x := NIL;
  830.                 LOOP
  831.                     IF sym = ident THEN
  832.                         qualident(id); y := OPB.NewLeaf(id);
  833.                         IF (id # NIL) & (id^.typ^.form = Pointer) & ((id^.mode = VarPar) OR ~id^.leaf) THEN
  834.                             err(-302)    (* warning 302 *)
  835.                         END ;
  836.                         CheckSym(colon);
  837.                         IF sym = ident THEN qualident(t);
  838.                             IF t^.mode = Typ THEN
  839.                                 IF id # NIL THEN
  840.                                     idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ
  841.                                 ELSE err(130)
  842.                                 END
  843.                             ELSE err(52)
  844.                             END
  845.                         ELSE err(ident)
  846.                         END
  847.                     ELSE err(ident)
  848.                     END ;
  849.                     pos := OPM.errpos; CheckSym(do); StatSeq(s); OPB.Construct(Nif, y, s); SetPos(y);
  850.                     IF idtyp # NIL THEN id^.typ := idtyp; idtyp := NIL END ;
  851.                     IF x = NIL THEN x := y; lastif := x ELSE OPB.Link(x, lastif, y) END ;
  852.                     IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  853.                 END;
  854.                 e := sym = else;
  855.                 IF e THEN OPS.Get(sym); StatSeq(s) ELSE s := NIL END ;
  856.                 OPB.Construct(Nwith, x, s); CheckSym(end);
  857.                 IF e THEN x^.subcl := 1 END
  858.             ELSIF sym = exit THEN
  859.                 OPS.Get(sym);
  860.                 IF LoopLevel = 0 THEN err(46) END ;
  861.                 OPB.Construct(Nexit, x, NIL);
  862.                 pos := OPM.errpos
  863.             ELSIF sym = return THEN OPS.Get(sym);
  864.                 IF sym < semicolon THEN Expression(x) END ;
  865.                 IF level > 0 THEN OPB.Return(x, OPT.topScope^.link)
  866.                 ELSE (* not standard Oberon *) OPB.Return(x, NIL)
  867.                 END ;
  868.                 pos := OPM.errpos
  869.             END ;
  870.             IF x # NIL THEN SetPos(x); OPB.Link(stat, last, x) END ;
  871.             IF sym = semicolon THEN OPS.Get(sym)
  872.             ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN err(semicolon)
  873.             ELSE EXIT
  874.             END
  875.         END
  876.     END StatSeq;
  877.     PROCEDURE Block(VAR procdec, statseq: OPT.Node);
  878.         VAR typ: OPT.Struct;
  879.             obj, first, last: OPT.Object;
  880.             x, lastdec: OPT.Node;
  881.             i: INTEGER;
  882.     BEGIN first := NIL; last := NIL; nofFwdPtr := 0;
  883.         LOOP
  884.             IF sym = const THEN
  885.                 OPS.Get(sym);
  886.                 WHILE sym = ident DO
  887.                     OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  888.                     obj^.typ := OPT.sinttyp; obj^.mode := Var;    (* Var to avoid recursive definition *)
  889.                     IF sym = eql THEN
  890.                         OPS.Get(sym); ConstExpression(x)
  891.                     ELSIF sym = becomes THEN
  892.                         err(eql); OPS.Get(sym); ConstExpression(x)
  893.                     ELSE err(eql); x := OPB.NewIntConst(1)
  894.                     END ;
  895.                     obj^.mode := Con; obj^.typ := x^.typ; obj^.conval := x^.conval; (* ConstDesc ist not copied *)
  896.                     CheckSym(semicolon)
  897.                 END
  898.             END ;
  899.             IF sym = type THEN
  900.                 OPS.Get(sym);
  901.                 WHILE sym = ident DO
  902.                     OPT.Insert(OPS.name, obj); obj^.mode := Typ; obj^.typ := OPT.undftyp;
  903.                     CheckMark(obj^.vis);
  904.                     IF sym = eql THEN
  905.                         OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  906.                     ELSIF (sym = becomes) OR (sym = colon) THEN
  907.                         err(eql); OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  908.                     ELSE err(eql)
  909.                     END ;
  910.                     IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ;
  911.                     IF obj^.typ^.comp IN {Record, Array, DynArr} THEN
  912.                         i := 0;
  913.                         WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i);
  914.                             IF typ^.link^.name = obj^.name THEN typ^.BaseTyp := obj^.typ; typ^.link^.name := "" END
  915.                         END
  916.                     END ;
  917.                     CheckSym(semicolon)
  918.                 END
  919.             END ;
  920.             IF sym = var THEN
  921.                 OPS.Get(sym);
  922.                 WHILE sym = ident DO
  923.                     LOOP
  924.                         IF sym = ident THEN
  925.                             OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  926.                             obj^.mode := Var; obj^.link := NIL; obj^.leaf := obj^.vis = internal; obj^.typ := OPT.undftyp;
  927.                             IF first = NIL THEN first := obj END ;
  928.                             IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ;
  929.                             last := obj
  930.                         ELSE err(ident)
  931.                         END ;
  932.                         IF sym = comma THEN OPS.Get(sym)
  933.                         ELSIF sym = ident THEN err(comma)
  934.                         ELSE EXIT
  935.                         END
  936.                     END ;
  937.                     CheckSym(colon); Type(typ, OPT.notyp);
  938.                     IF typ^.comp = DynArr THEN typ := OPT.undftyp; err(88) END ;
  939.                     WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  940.                     CheckSym(semicolon)
  941.                 END
  942.             END ;
  943.             IF (sym < const) OR (sym > var) THEN EXIT END ;
  944.         END ;
  945.         i := 0;
  946.         WHILE i < nofFwdPtr DO
  947.             IF FwdPtr[i]^.link^.name # "" THEN err(128) END ;
  948.             FwdPtr[i] := NIL;    (* garbage collection *)
  949.             INC(i)
  950.         END ;
  951.         OPT.topScope^.adr := OPM.errpos;
  952.         procdec := NIL; lastdec := NIL;
  953.         WHILE sym = procedure DO
  954.             OPS.Get(sym); ProcedureDeclaration(x);
  955.             IF x # NIL THEN
  956.                 IF lastdec = NIL THEN procdec := x ELSE lastdec^.link := x END ;
  957.                 lastdec := x
  958.             END ;
  959.             CheckSym(semicolon)
  960.         END ;
  961.         IF sym = begin THEN OPS.Get(sym); StatSeq(statseq)
  962.         ELSE statseq := NIL
  963.         END ;
  964.         IF (level = 0) & (TDinit # NIL) THEN
  965.             lastTDinit^.link := statseq; statseq := TDinit
  966.         END ;
  967.         CheckSym(end)
  968.     END Block;
  969.     PROCEDURE Module*(VAR prog: OPT.Node; VAR modName: OPS.Name);
  970.         VAR impName, aliasName: OPS.Name;
  971.                 procdec, statseq: OPT.Node;
  972.                 c: LONGINT;
  973.     BEGIN
  974.         LoopLevel := 0; level := 0;
  975.         OPS.Get(sym);
  976.         IF sym = module THEN OPS.Get(sym) ELSE err(16) END ;
  977.         IF sym = ident THEN
  978.             COPY(OPS.name, modName); OPS.Get(sym); CheckSym(semicolon);
  979.             IF sym = import THEN OPS.Get(sym);
  980.                 LOOP
  981.                     IF sym = ident THEN
  982.                         COPY(OPS.name, aliasName); COPY(aliasName, impName); OPS.Get(sym);
  983.                         IF sym = becomes THEN OPS.Get(sym);
  984.                             IF sym = ident THEN COPY(OPS.name, impName); OPS.Get(sym) ELSE err(ident) END
  985.                         END ;
  986.                         OPT.Import(aliasName, impName, modName)
  987.                     ELSE err(ident)
  988.                     END ;
  989.                     IF sym = comma THEN OPS.Get(sym)
  990.                     ELSIF sym = ident THEN err(comma)
  991.                     ELSE EXIT
  992.                     END
  993.                 END ;
  994.                 CheckSym(semicolon)
  995.             END ;
  996.             IF OPM.noerr THEN TDinit := NIL; lastTDinit := NIL; c := OPM.errpos;
  997.                 Block(procdec, statseq); OPB.Enter(procdec, statseq, NIL); prog := procdec;
  998.                 prog^.conval := OPT.NewConst(); prog^.conval^.intval := c;
  999.                 IF sym = ident THEN
  1000.                     IF OPS.name # modName THEN err(4) END ;
  1001.                     OPS.Get(sym)
  1002.                 ELSE err(ident)
  1003.                 END ;
  1004.                 IF sym # period THEN err(period) END
  1005.             END
  1006.         ELSE err(ident)
  1007.         END ;
  1008.         TDinit := NIL; lastTDinit := NIL
  1009.     END Module;
  1010. END POPP.
  1011.